home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch18 / Pline4d.cls < prev    next >
Text File  |  1999-07-10  |  4KB  |  138 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "Polyline4d"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = False
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16. ' Point4D and Segment4D are defined in module M4ops.bas as:
  17. '    Type Point4D
  18. '        coord(1 To 4) As Single
  19. '        trans(1 To 4) As Single
  20. '    End Type
  21. '
  22. '    Type Segment4D
  23. '        pt1 As Integer
  24. '        pt2 As Integer
  25. '    End Type
  26.  
  27. Private NumPoints As Integer ' Number of points.
  28. Private Points() As Point4D  ' Data points.
  29.  
  30. Private NumSegs As Integer   ' Number of segments.
  31. Private Segs() As Segment4D  ' The segments.
  32. ' Add one or more line segments to the polyline.
  33. Public Sub AddSegment(ParamArray coord() As Variant)
  34. Dim num_segs As Integer
  35. Dim i As Integer
  36. Dim last As Integer
  37. Dim pt As Integer
  38.  
  39.     num_segs = (UBound(coord) + 1) \ 4 - 1
  40.     ReDim Preserve Segs(1 To NumSegs + num_segs)
  41.  
  42.     last = AddPoint((coord(0)), (coord(1)), (coord(2)), (coord(3)))
  43.     pt = 0
  44.     For i = 1 To num_segs
  45.         Segs(NumSegs + i).pt1 = last
  46.         pt = pt + 4
  47.         last = AddPoint((coord(pt)), (coord(pt + 1)), (coord(pt + 2)), (coord(pt + 3)))
  48.         Segs(NumSegs + i).pt2 = last
  49.     Next i
  50.  
  51.     NumSegs = NumSegs + num_segs
  52. End Sub
  53. ' Add a point to the polyline or reuse a point.
  54. ' Return the point's index.
  55. Private Function AddPoint(ByVal X As Single, ByVal y As Single, ByVal z As Single, ByVal W As Single) As Integer
  56. Dim i As Integer
  57.  
  58.     ' See if the point is already here.
  59.     For i = 1 To NumPoints
  60.         If X = Points(i).coord(1) And _
  61.            y = Points(i).coord(2) And _
  62.            z = Points(i).coord(3) And _
  63.            W = Points(i).coord(4) Then _
  64.                 Exit For
  65.     Next i
  66.     AddPoint = i
  67.  
  68.     ' If so, we're done.
  69.     If i <= NumPoints Then Exit Function
  70.  
  71.     ' Otherwise create the new point.
  72.     NumPoints = NumPoints + 1
  73.     ReDim Preserve Points(1 To NumPoints)
  74.     Points(i).coord(1) = X
  75.     Points(i).coord(2) = y
  76.     Points(i).coord(3) = z
  77.     Points(i).coord(4) = W
  78.     Points(i).coord(5) = 1#
  79. End Function
  80.  
  81.  
  82. ' Apply a transformation matrix which may not
  83. ' contain 0, 0, 0, 0, 1 in the last column to the
  84. ' object.
  85. Public Sub ApplyFull(M() As Single)
  86. Dim i As Integer
  87.  
  88.     For i = 1 To NumPoints
  89.         m4ApplyFull Points(i).coord, M, Points(i).trans
  90.     Next i
  91. End Sub
  92.  
  93. ' Apply a transformation matrix to the object.
  94. Public Sub Apply(M() As Single)
  95. Dim i As Integer
  96.  
  97.     For i = 1 To NumPoints
  98.         m4Apply Points(i).coord, M, Points(i).trans
  99.     Next i
  100. End Sub
  101.  
  102.  
  103. ' Draw the transformed points on a PictureBox.
  104. Public Sub Draw(ByVal pic As PictureBox, Optional r As Variant)
  105. Dim seg As Integer
  106. Dim pt1 As Integer
  107. Dim pt2 As Integer
  108. Dim dist As Single
  109.  
  110.     On Error Resume Next
  111.     If IsMissing(r) Then r = INFINITY
  112.     dist = r
  113.     For seg = 1 To NumSegs
  114.         pt1 = Segs(seg).pt1
  115.         pt2 = Segs(seg).pt2
  116.         ' Don't draw if either point is farther
  117.         ' from the focus point than the center of
  118.         ' projection (which is distance dist away).
  119.         If (Points(pt1).trans(4) < r) And (Points(pt2).trans(4) < r) Then _
  120.             pic.Line _
  121.                 (Points(pt1).trans(1), Points(pt1).trans(2))- _
  122.                 (Points(pt2).trans(1), Points(pt2).trans(2))
  123.     Next seg
  124. End Sub
  125. ' Copy the transformed points into the data points.
  126. Public Sub FixPoints()
  127. Dim i As Integer
  128. Dim j As Integer
  129.  
  130.     For i = 1 To NumPoints
  131.         For j = 1 To 5
  132.             Points(i).coord(j) = Points(i).trans(j)
  133.         Next j
  134.     Next i
  135. End Sub
  136.  
  137.  
  138.